home *** CD-ROM | disk | FTP | other *** search
/ Light ROM Gold / Light ROM Gold.iso / arexx / modeler / wrapsphe.rex < prev   
OS/2 REXX Batch file  |  1995-03-23  |  3KB  |  114 lines
  1. From shf@well.sf.ca.us Tue Aug 10 19:12:41 1993
  2. Return-Path: <shf@well.sf.ca.us>
  3. Received: from RUTGERS.EDU by netcom3.netcom.com (5.65/SMI-4.1/Netcom)
  4.     id AA04569; Tue, 10 Aug 93 19:12:39 -0700
  5. Received: from bobsbox.rent.com by rutgers.edu (5.59/SMI4.0/RU1.5/3.08) with UUCP 
  6.     id AA15826; Tue, 10 Aug 93 16:25:37 EDT
  7. Received: by bobsbox.rent.com (V1.16/Amiga)
  8.     id AA02zx1; Tue, 10 Aug 93 12:46:12 EDT
  9. Received: from nkosi.well.sf.ca.us by rutgers.edu (5.59/SMI4.0/RU1.5/3.08) 
  10.     id AA29623; Tue, 10 Aug 93 04:03:44 EDT
  11. Received: from well.sf.ca.us (well.sf.ca.us [192.132.30.2]) by nkosi.well.sf.ca.us (8.5/8.5) with SMTP id BAA04606; Tue, 10 Aug 1993 01:03:40 -0700
  12. Received: by well.sf.ca.us id <14046-2>; Tue, 10 Aug 1993 01:03:10 -0700
  13. Message-Id: <93Aug10.010310pdt.14046-2@well.sf.ca.us>
  14. Date:     Tue, 10 Aug 1993 01:03:10 -0700
  15. From: "Stuart H. Ferguson" <shf@well.sf.ca.us>
  16. To: lightwave@bobsbox.rent.com
  17. Subject: Conform to Sphere script
  18. Status: OR
  19.  
  20. Having been challenged by Imagine's "Conform to Sphere" operation, I
  21. sat down and wrote an ARexx script for Modeler 3.0 that does a 
  22. similar function.  I only spent a few minutes on it, so it does not
  23. have a lot of bells and whistles, but it does do essentially the 
  24. desired transformation.  Hope this helps the fellow who wanted to
  25. do this ...
  26.  
  27.     Stuart Ferguson
  28. -----------------------
  29.  
  30. /*
  31.  * Wrap Data onto Sphere -- Modeler ARexx transform.
  32.  *
  33.  * 8/93  Stuart Ferguson
  34.  */
  35.  
  36.     mxx="LWModelerARexx.port"
  37.     signal on error
  38.     signal on syntax
  39.     check = addlib("rexxmathlib.library",0,-30,0)
  40.     mxx_add = addlib(mxx,0)
  41.     call main
  42.     if (mxx_add) then call remlib(mxx)
  43.     exit
  44.  
  45.     syntax:
  46.     error:
  47.     t=Notify(1,'!Rexx Script Error','@'ErrorText(rc),'Line 'SIGL)
  48.     if (mxx_add) then call remlib(mxx)
  49.     exit
  50.  
  51.  
  52. main:
  53.  
  54. syscode = "Wrap Sphere"
  55.  
  56.  
  57. /* Get size and thickness of sphere from user.
  58.  */
  59. call req_begin syscode
  60.  
  61. id_inr = req_addcontrol("Inner Radius", 'n', 1)
  62. id_otr = req_addcontrol("Outer Radius", 'n', 1)
  63. id_sel = req_addcontrol("Points", 'c', 'All Selected')
  64. call req_setval id_inr, 1.0, 1.0
  65. call req_setval id_otr, 2.0, 2.0
  66. call req_setval id_sel, 2
  67.  
  68. if (~req_post()) then return
  69.  
  70. r1 = req_getval(id_inr)
  71. r2 = req_getval(id_otr)
  72. call sel_mode word('global user',req_getval(id_sel))
  73.  
  74. call req_end
  75.  
  76.  
  77. /* Get extent of data area.  This will just take the extent in
  78.  * X and Y and map it to lat and long on the sphere, and the
  79.  * extent in Z and map it to r1 and r2.
  80.  */
  81. parse value boundingbox() with n x1 x2 y1 y2 z1 z2 .
  82. dx = x2 - x1
  83. dy = y2 - y1
  84. dz = z2 - z1
  85. if (n <= 0 | dx <= 0 | dy <= 0) then return
  86. d2r = 3.1415926 / 180
  87.  
  88. /* Transform loop
  89.  */
  90. n = xfrm_begin()
  91. call meter_begin n, syscode
  92. do i = 1 to n
  93.     parse value xfrm_getpos(i) with x y z .
  94.  
  95.     lat = d2r * ((y - y1) / dy * 180 - 90)
  96.     lon = d2r * ((x - x1) / dx * 360)
  97.     if (dz <= 0) then rad = r1
  98.                  else rad = (z - z1) / dz * (r2 - r1) + r1
  99.  
  100.     y = rad * sin(lat)
  101.     p = rad * cos(lat)
  102.     x = p * sin(lon)
  103.     z = p * cos(lon)
  104.  
  105.     call xfrm_setpos i, x y z
  106.     call meter_step
  107. end
  108. call meter_end
  109. call xfrm_end
  110.  
  111. return
  112. ------------------------- end
  113.  
  114.